home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / pstui100.zip / DEMO1.PAS next >
Pascal/Delphi Source File  |  1993-05-01  |  20KB  |  526 lines
  1. {
  2.  
  3.                                                       ╔══════════════════╗
  4.                                                       ║   PTUI  Demo     ║
  5.                                                       ║                  ║
  6.                                                       ║    Rev. 1.00     ║
  7.                                                       ╚══════════════════╝
  8.  
  9. }
  10.  
  11. Program Demo;
  12.  
  13. {$F-} {$O-} {$A+} {$G-}
  14. {$V-} {$B-} {$X-} {$N+} {$E+}
  15.  
  16. {$I FINAL.PAS}
  17.  
  18. {$IFDEF FINAL}
  19.   {$I-} {$R-}
  20.  
  21.   {$IFDEF VER70}
  22.     {$Q-} {$P-}
  23.   {$ENDIF}
  24.  
  25.   {$D-} {$L-} {$S-}
  26.   {$M 8192,262144,655360}
  27. {$ELSE}
  28.   {$M 8192,0,655360}
  29. {$ENDIF}
  30.  
  31. Uses CRT,Strings,PTUI,PTUIVCRT,KeyDef;
  32.  
  33. Procedure BusyExample;
  34.  
  35. Var
  36.   Pop   :TextWindow;
  37.   X     :Word;
  38.  
  39. Begin
  40.   Pop.Open(44,5,72,11,White,LightGrey,Black,Black,NoLine,Solid);
  41.   {Open a Window, Solid Colour, No Line}
  42.   Pop.NewHeading('Working',CentreText,White,Green);
  43.   {Use the heading 'Working', centre the white on green text}
  44.   Pop.Lock;
  45.   {Use relative coordinates, GotoXY(1,1) is now (44,5)}
  46.   VideoColor(White,LightGrey);
  47.   GotoXY(10,4);
  48.   WriteStr('Not Really');
  49.   {Display message in window - Notice, WriteStr instead of Write}
  50.  
  51.   For X:=1 to 366 do         {Our scale is 0 to 366}
  52.   Begin
  53.     Barometer(3,6,25,#219,X,366);       {Draw updated barometer}
  54.     Delay(10);                          {Pretend to do something}
  55.   End;
  56.  
  57.   Pop.UnLock;
  58.   {Must do this - Reset coordinates}
  59.   Pop.Close;
  60.   {Must do this - release memory from heap}
  61. End;
  62.  
  63. Var
  64.   Win       :Array [1..2] of TextWindow;                 {2 Windows}
  65.   WinBut    :Array [1..2] of Array [1..7] of Word;       {2x7 Buttons}
  66.   NewSlide  :SlideBarInfo;                               {A Slide Bar Info}
  67.   DelBut,
  68.   ActiveWin :Byte;
  69.   St        :String;
  70.  
  71.   MX,MY     :Word;
  72.   MB        :Byte;
  73.   Held,
  74.   Doubled,
  75.   Special   :Boolean;
  76.   Key       :Char;
  77.  
  78.   SmoothX,
  79.   SmoothY   :Byte;
  80.  
  81.   TestGet,
  82.   Param     :String;
  83.  
  84. Begin
  85.   If ParamCount>0 Then
  86.     UpperCase(ParamStr(1),Param)
  87.   Else
  88.     Param:='';
  89.  
  90.   If Pos('?',Param)>0 Then
  91.   Begin
  92.     WriteLn('Use /C for CGA, /E for EGA or /V for VGA.  /V is the default.');
  93.     WriteLn('If you have a mono card, this will be detected automatically.');
  94.     WriteLn;
  95.     WriteLn('If you have a TSeng Super VGA, use /S.  Other Super VGA''s: See Docs.');
  96.     Halt;
  97.   End;
  98.  
  99.   If (Card=ColorCard) Then
  100.   Begin
  101.     If Pos('/E',Param)>0 Then                           {EGA?}
  102.     Begin
  103.       VideoCard[ColorCard].CharacterHeight:=14;         {Set Character Size}
  104.       EnableVScreen(EGA);
  105.       VideoCard[Card].ScrollMethod:=ScrollMethod3;      {EGA Scroll}
  106.     End;
  107.     If (Pos('/V',Param)>0) Or (Param='') Then           {VGA?}
  108.       EnableVScreen(VGA);
  109.     If Pos('/S',Param)>0 Then                           {SVGA?}
  110.     Begin
  111.       VideoCard[Card].CardType:=SVGA;
  112.  
  113.       {***********************************************************}
  114.  
  115.                     { Put your SVGA mode number below}
  116.  
  117.       {***********************************************************}
  118.  
  119.       TextMode($26,0,0,0);
  120.  
  121.       {***********************************************************}
  122.  
  123.       EnableVScreen(SVGA);
  124.       VideoCard[Card].ScrollMethod:=ScrollMethod2;      {SVGA Scroll}
  125.     End;
  126.     If Pos('/C',Param)=0 Then
  127.       SetVirtualScreen(160,70);                         {Nice big screen}
  128.   End;
  129.  
  130.   TestGet:='';
  131.   PushCursorSize;               {Save the DOS cursor Size}
  132.   CursorSize($20,$20);          {Kill the cursor (fails on old VGA's)}
  133.   Cursor:=False;                {Don't update cursor position - save time}
  134.   Mouse.Init(True);             {Check for a Mouse}
  135.   InstallVScreenMouse;          {Install Internal Mouse Driver}
  136.   TextBackground(Blue);
  137.   TextColor(Yellow);
  138.   ClrScr;                       {We've set everything up now, Clear Screen}
  139.   GotoXY(2,2);
  140.   WriteStr(#7+' Click here to exit or press [Esc] to exit.');
  141.   GotoXY(4,3);
  142.   WriteStr('Swap between windows with Right Mouse Button or [Tab].  [E] tests the string editor.');
  143.   GotoXY(4,4);
  144.   WriteStr('Mouse users can drag the window by holding on to the heading and moving the mouse.');
  145.   GotoXY(4,5);
  146.   WriteStr('Keyboard users (no mouse) can use [Ctrl][F5] and the cursor keys, followed by [Return].');
  147.   GotoXY(4,6);
  148.   WriteStr('Use the mouse or [Ctrl][PgUp] [PgDn] [Left] [Right] to scroll across the VGA virtual screen.');
  149.  
  150.   Window(40,10,130,30);
  151.   WriteStrLn('                                       ▄▄');
  152.   WriteStrLn('  ██████▄ █████████  ██    ██  ██ ██   ▐█▌  ▄████▄  █████▄  █████████');
  153.   WriteStrLn(' ▐█▌   ▐█▌   ▐█▌    ▐█▌   ▐█▌ ▐█▌ ██    ██ ██▀  ▀▀ ▐█▌   █▌    ▐█▌');
  154.   WriteStrLn(' ██   ▄██    ██     ██    ██  ██  ██   ▐█▌▐█▌      ██ ▄▄█▀     ██');
  155.   WriteStrLn(' ██████▀     ██     ██    ██  ██  ██   ██ ██       ██ ██       ██');
  156.   WriteStrLn('▐█▌         ▐█▌    ▐█▌   ▐█▌ ▐█▌  ██ ▄██  ██▄  ▄▄ ▐█▌  ██     ▐█▌');
  157.   WriteStrLn('██          ██      ▀██████  ██   ████▀    ▀███▀  ██   ▀██    ██');
  158.   Window(1,1,VideoCard[Card].XSize,VideoCard[Card].YSize);
  159.  
  160.   SmoothX:=VideoCard[ColorCard].CharacterLength Div 8;
  161.   SmoothY:=VideoCard[ColorCard].CharacterHeight Div 8;
  162.  
  163.   {Work out how many pixels to smooth scroll}
  164.  
  165.   DelBut:=1;    {Smooth Scroll Temp Variable}
  166.   While (DelBut<30) And (Not KeyPressed) do
  167.   Begin
  168.     Inc(DelBut);
  169.  
  170.     If Not KeyPressed Then
  171.     Begin
  172.  
  173.       ScreenOrigin((VideoCard[Card].SX1 - 1) * VideoCard[Card].CharacterLength + SmoothX,
  174.                    (VideoCard[Card].SY1 - 1) * VideoCard[Card].CharacterHeight);
  175.  
  176.       ScreenOrigin((VideoCard[Card].SX1 - 1) * VideoCard[Card].CharacterLength + SmoothX*3,
  177.                    (VideoCard[Card].SY1 - 1) * VideoCard[Card].CharacterHeight);
  178.  
  179.       ScreenOrigin((VideoCard[Card].SX1 - 1) * VideoCard[Card].CharacterLength + SmoothX*5,
  180.                    (VideoCard[Card].SY1 - 1) * VideoCard[Card].CharacterHeight);
  181.  
  182.       ScreenOrigin((VideoCard[Card].SX1 - 1) * VideoCard[Card].CharacterLength + SmoothX*7,
  183.                    (VideoCard[Card].SY1 - 1) * VideoCard[Card].CharacterHeight);
  184.     End;
  185.  
  186.     ScreenOrigin((VideoCard[Card].SX1) * VideoCard[Card].CharacterLength,
  187.                  (VideoCard[Card].SY1 - 1) * VideoCard[Card].CharacterHeight);
  188.  
  189.     {The lazy man's ^KC smooth scroll  ;-)}
  190.  
  191.   End;
  192.  
  193.   ScreenOrigin(0,0);
  194.  
  195.   Win[1].Open(10,10,50,20,Yellow,Green,Blue,Magenta,NoLine,Solid);
  196.   Win[1].NewHeading('Window 1',CentreText,Yellow,Red);
  197.   Win[1].HeadingIcon(True);  {Make the heading a button to drag window}
  198.  
  199.   NewSlide.X1:=48;
  200.   NewSlide.Y1:=13;
  201.   NewSlide.X2:=48;              {Setup information for our vertical slide bar}
  202.   NewSlide.Y2:=19;
  203.   NewSlide.Forg:=Yellow;
  204.   NewSlide.Back:=Green;
  205.   NewSlide.MainChar:='░';
  206.   NewSlide.ButtonChar:='▓';
  207.   NewSlide.UpLeftChar:=#$18;
  208.   NewSlide.DownRightChar:=#$19;
  209.   NewSlide.CurPos:=0;
  210.   NewSlide.MaxPos:=99;
  211.  
  212.   Win[1].VertSlideBar(NewSlide);        {Activate the slide bar}
  213.  
  214.   NewSlide.X1:=12;
  215.   NewSlide.Y1:=19;
  216.   NewSlide.X2:=47;
  217.   NewSlide.Y2:=19;                      {More exciting information}
  218.   NewSlide.UpLeftChar:=#$1B;
  219.   NewSlide.DownRightChar:=#$1A;
  220.  
  221.   Win[1].HorzSlideBar(NewSlide);        {Setup the Horizontal Slide Bar}
  222.  
  223.   Win[1].VertSlideIcon(True);           {Turn the Slide Bars into Buttons}
  224.   Win[1].HorzSlideIcon(True);
  225.  
  226.  
  227.   {Okay, this part is done the 'easy' way.  I could setup a linked list
  228.    of buttons and check for them but rather I'm going to add them to
  229.    each window.}
  230.  
  231.   Win[1].Buttons.Add(2,2,2,2,False,#27);  {Add the Close Application Button, [Esc]=#27}
  232.   WinBut[1][1]:=Win[1].Buttons.Number;    {Remember the button number}
  233.   Win[1].Buttons.Add(0,0,0,0,False,#9);   {0,0,0,0 for Key PressOnly, No Mouse Equivalent}
  234.   WinBut[1][2]:=Win[1].Buttons.Number;    {These are allocated 'randomly'}
  235.   Win[1].Buttons.Add(0,0,0,0,SpecialCode(Key_Ctrl,Key_Right),KeyCode(Key_Ctrl,Key_Right));
  236.   WinBut[1][3]:=Win[1].Buttons.Number;
  237.   Win[1].Buttons.Add(0,0,0,0,SpecialCode(Key_Ctrl,Key_Left) ,KeyCode(Key_Ctrl,Key_Left));
  238.   WinBut[1][4]:=Win[1].Buttons.Number;
  239.   Win[1].Buttons.Add(0,0,0,0,Specia